home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS19.ADF / HouseHold / HouseInv < prev    next >
Text File  |  1989-01-27  |  25KB  |  910 lines
  1. ' The Household Inventory System
  2. ' ------------------------------
  3. ' This is Program #1 of 3:  "HouseInv" -the main program
  4. ' Program #2 is the "HouseInvPrint" program
  5. ' Program #3 is the "HouseInvMaint" program
  6. ' 
  7. ' Please do not modify the title screen in any way.
  8. ' January 1987
  9. '
  10. CLEAR ,35000&
  11. numbx=52:NumFlds=8:maxdisp=18
  12. MouseInd=0:FldNum=0:RecCnt=0:CurCol=0:TxtCol=0:NewCur=0:type=0
  13. n=0:m=0:first=0:last=0:OldCnt=0:ErrSw=0:RecNum=0:RC=0:siz=0
  14. x%=0:Lgth%=0:clm%=0:row%=0:offset%=0:offsetp%=0:MouseY%=0
  15. Sldlgth%=0:SldStrt%=0:SldLft%=0:BarStrt%=0:GRx%=0:GRy%=0
  16. A%=0:B%=0:SvA%=0:SvB%=0:BarLgth%=0:Spare%=0:Hi1st%=0
  17. Today$="":strg$="":type$="":x$="":Sep$=""
  18. DIM bx(numbx-1,6),bxtxt$(numbx-1)
  19. DIM FldTxt$(NumFlds-1,1),FldVal$(NumFlds-1)
  20. DIM Fldlen(NumFlds-1),HldVal$(NumFlds-1)
  21. Logo80 3:TxtCol=Blk
  22. COLOR Red,Blk:LOCATE 9,34:PRINT"Please Standby."
  23. Bldgadgets numbx,bx(),bxtxt$()
  24. ' Main Title
  25. DATA 120, 60, 80, 16,0,2, 7,"  Add"
  26. DATA 280, 60, 80, 16,0,2, 7," Review"
  27. DATA 440, 60, 80, 16,0,4, 7,"  Quit"
  28. ' Add
  29. DATA  90,148, 56, 16,7,4, 0,"Cancel"
  30. DATA 148,148, 52, 16,7,2, 0,"  OK"
  31. DATA 202,148, 57, 16,7,1, 0,"Modify"
  32. DATA 114,148, 73, 16,7,1, 0,"Add More"
  33. DATA 189,148, 54, 16,7,4, 0," Quit"
  34. ' Add/Change
  35. DATA 166,  7,100,  9,1,7,-1,""
  36. DATA 166, 23,132,  9,1,7,-1,""
  37. DATA 166, 39, 76,  9,1,7,-1,""
  38. DATA 166, 55, 60,  9,1,7,-1,""
  39. DATA 166, 71, 60,  9,1,7,-1,""
  40. DATA 166, 87, 60,  9,1,7,-1,""
  41. DATA 166,103,132,  9,1,7,-1,""
  42. DATA 166,119,172,  9,1,7,-1,""
  43. DATA 124,148, 55, 16,7,4, 0,"Cancel"
  44. DATA 181,148, 54, 16,7,2, 0,"  OK"
  45. ' Review
  46. DATA   8, 40,576,  8,3,3,-2,""
  47. DATA   8, 48,576,  8,3,3,-2,""
  48. DATA   8, 56,576,  8,3,3,-2,""
  49. DATA   8, 64,576,  8,3,3,-2,""
  50. DATA   8, 72,576,  8,3,3,-2,""
  51. DATA   8, 80,576,  8,3,3,-2,""
  52. DATA   8, 88,576,  8,3,3,-2,""
  53. DATA   8, 96,576,  8,3,3,-2,""
  54. DATA   8,104,576,  8,3,3,-2,""
  55. DATA   8,112,576,  8,3,3,-2,""
  56. DATA   8,120,576,  8,3,3,-2,""
  57. DATA   8,128,576,  8,3,3,-2,""
  58. DATA   8,136,576,  8,3,3,-2,""
  59. DATA   8,144,576,  8,3,3,-2,""
  60. DATA   8,152,576,  8,3,3,-2,""
  61. DATA   8,160,576,  8,3,3,-2,""
  62. DATA   8,168,576,  8,3,3,-2,""
  63. DATA   8,176,576,  8,3,3,-2,""
  64. DATA 508, 12, 88, 16,0,2, 7," Finished" 
  65. DATA 600, 40, 24, 12,0,0,-2,""
  66. DATA 600, 52, 24,120,1,7,-2,""
  67. DATA 600,172, 24, 12,0,0,-2,""
  68. ' Count Initialization
  69. DATA  28, 36, 24, 16,7,4, 0,"No"
  70. DATA 116, 36, 24, 16,7,2, 0,"OK"
  71. ' Count Display
  72. DATA 116, 76, 24, 16,7,2, 0,"OK"
  73. ' Update a Record
  74. DATA  90,148, 56, 16,7,1, 0,"Modify"
  75. DATA 148,148, 52, 16,7,2, 0,"  OK"
  76. DATA 202,148, 57, 16,7,4, 0,"Delete"
  77. ' Record Delete Query
  78. DATA  20, 36, 24, 16,7,4, 0,"No"
  79. DATA 116, 36, 24, 16,7,2, 0,"OK"
  80. ' Restore Deleted Record Query
  81. DATA  68,100, 48, 16,7,2, 0," Yes"
  82. DATA 228,100, 48, 16,7,4, 0,"  No"
  83. ' Help Windows
  84. DATA  36,172, 40, 16,7,4, 0,"More"
  85. DATA 156,172, 40, 16,7,2, 0," OK"
  86. MTA%=0:MTB%=2
  87. AddA%=3:AddB%=4:AddC%=5:AddD%=6:AddE%=7
  88. ChgA%=8:ChgB%=15:ChgC%=16:ChgD%=17
  89. RevA%=18:RevB%=35:RevC%=36:RevD%=37:RevE%=38:RevF%=39
  90. InA%=40:InB%=41
  91. CnA%=42
  92. UpdA%=43:UpdB%=45
  93. DelA%=46:DelB%=47
  94. DQA%=48:DQB%=49
  95. HlpA%=50:HlpB%=51
  96. FOR n=0 TO NumFlds-1
  97.   READ FldTxt$(n,0),FldTxt$(n,1),Fldlen%(n)
  98. NEXT
  99. DATA "Room:","(Required)",10
  100. DATA "Item(s):","(Required)",15
  101. DATA "Date of Purchase:","(mm/dd/yy)", 8
  102. DATA "Original Cost:","(In Dollars)", 6
  103. DATA "Current Worth:","(In Dollars)", 6
  104. DATA "Replacement Cost:","(In Dollars)", 6
  105. DATA "Serial Number:","",15
  106. DATA "Comments:","",20
  107. Sldlgth%=INT(bx(RevE%,3)-2):SldStrt%=INT(bx(RevE%,1)+1)
  108. SldLft%=INT(bx(RevE%,0)+4)
  109. MENU 1,0,1,"Project:"
  110. MENU 1,1,1,"Quit    "
  111. MENU 2,0,1,"Help:"
  112. MENU 2,1,1,"General      "
  113. MENU 2,2,1,"Add          "
  114. MENU 2,3,1,"Review       "
  115. MENU 2,4,1,"Data File    "
  116. MENU 2,5,1,"HouseInvPrint"
  117. MENU 2,6,1,"HouseInvMaint"
  118. MENU 3,0,1,"Data File:"
  119. MENU 3,1,1,"Initialize    "
  120. MENU 3,2,0,"Update Count  "
  121. MENU 3,3,0,"No. of Records"
  122. MENU 4,0,0,""
  123. ON MENU GOSUB MenuRtns:MENU ON 
  124. COLOR Yel,Blk
  125. LOCATE 22,19:PRINT"First use of program?  Please use HELP menu!"
  126. COLOR Cyn,Blk
  127. LOCATE 9,34:PRINT SPACE$(15)
  128. LOCATE 9,11:PRINT"Please enter today's date:"
  129. LOCATE 9,49:PRINT" (in mm/dd/yy format)"
  130. LINE(304,64)-STEP(74,7),Cyn,bf
  131. WHILE Today$="" OR LEN(Today$)<6
  132.   COLOR Blk,Cyn:LOCATE 9,39:GetIp Today$,"CHAR",8
  133. WEND
  134. LINE(80,56)-STEP(488,24),Blk,bf
  135. ON ERROR GOTO InitError
  136. GOSUB GetRecCnt
  137. InitCont:
  138. ON ERROR GOTO 0
  139. IF ErrSw=1 THEN ErrSw=0:RecCnt=0:GOSUB PutRecCnt
  140. OldCnt=RecCnt
  141. GOSUB OpenData
  142. DrawGadgets MTA%,MTB%,bx(),bxtxt$()
  143. LOCATE 22,19:PRINT SPACE$(44)
  144. MENU 3,2,1:MENU 3,3,1
  145. ON MOUSE GOSUB GetMouse
  146. GOTO Main1
  147.  
  148. ' Error Routine Used When Opening Count File During Initilization
  149. InitError:
  150. WINDOW 2
  151. IF ERR=53 THEN
  152.   ErrSw=1:RESUME InitCont
  153. ELSE
  154.   ON ERROR GOTO 0
  155. END IF
  156.  
  157. ' Open Main Data File
  158. ' -------------------
  159. OpenData:
  160. OPEN "R",#1,"HouseInv.Data",103
  161. FIELD #1,1 AS FFlg$,10 AS RFld$(0),15 AS RFld$(1),8 AS RFld$(2),6 AS RFld$(3),6 AS RFld$(4),6 AS RFld$(5),15 AS RFld$(6),20 AS RFld$(7),8 AS RAdd$,8 AS RChg$
  162. RETURN
  163.  
  164. ' Start of Main Processing
  165. ' ------------------------
  166. Main:
  167. Logo80 3
  168. DrawGadgets MTA%,MTB%,bx(),bxtxt$()
  169. Main1:
  170. COLOR Blu,Blk
  171. LOCATE 12,39:PRINT"THE"
  172. LOCATE 14,22:PRINT"H O U S E H O L D   I N V E N T O R Y"
  173. LOCATE 16,38:PRINT"SYSTEM"
  174. COLOR Mag,Blk
  175. LOCATE 18,18:PRINT"D A T A   E N T R Y  &  M A I N T E N A N C E"
  176. COLOR Yel,Blk:LOCATE 22,25:PRINT"Use HELP menus for assistance."
  177. Main2:
  178. A%=MTA%:B%=MTB%:MOUSE ON
  179. type=0:WHILE type=0:SLEEP:WEND:MOUSE OFF
  180. ON type GOTO AddRtn,ReviewRtn,Quit
  181.  
  182. ' Routine to ADD a New Record
  183. ' ---------------------------
  184. AddRtn:
  185. WINDOW 3,"Household Inventory: Add a New Item",(40,0)-(400,184),0,1
  186. AddClear:
  187. COLOR Blk,Cyn:CLS
  188. DrawGadgets AddA%,AddA%,bx(),bxtxt$()
  189. MouseInd=0:type=0
  190. A%=AddA%:B%=AddA%:MOUSE ON
  191. COLOR Blk,Cyn:x%=ChgA%-1
  192. FOR n=0 TO NumFlds-1:FldVal$(n)="":NEXT
  193. FOR n=0 TO NumFlds-1
  194.   FldNum=n
  195.   LOCATE 2+n*2,20-LEN(FldTxt$(n,0))+1:PRINT FldTxt$(n,0)
  196.   LOCATE 3+n*2,20-LEN(FldTxt$(n,1))+1:PRINT FldTxt$(n,1)
  197.   x%=x%+1:DrawGadgets x%,x%,bx(),bxtxt$()
  198.   strg$="":Lgth%=Fldlen%(n):COLOR Blk,Blu
  199.   IF n>2 AND n<6 THEN type$="REAL" ELSE type$="CHAR"
  200.   LOCATE 2+n*2,22:GetIp strg$,type$,Lgth%
  201.   IF n<2 THEN
  202.     IF MouseInd=0 THEN
  203.       WHILE strg$="":LOCATE 2+n*2,22:GetIp strg$,type$,Lgth%:WEND
  204.     END IF
  205.   END IF
  206.   IF MouseInd=0 THEN
  207.     FldVal$(n)=strg$
  208.     COLOR Blk,Cyn:LOCATE 3+n*2,1:PRINT SPACE$(20)
  209.     IF n=1 THEN
  210.       B%=AddC%:DrawGadgets AddB%,AddC%,bx(),bxtxt$()
  211.       COLOR Blk,Cyn
  212.     END IF
  213.   ELSE
  214.     COLOR Blk,Blu:n=NumFlds-1
  215.   END IF
  216. NEXT
  217. WHILE MouseInd=0:SLEEP:WEND
  218. ON type GOTO AddCancel,AddOK,AddChange
  219. AddCancel:
  220. FOR n=0 TO NumFlds-1:FldVal$(n)="":NEXT
  221. GOTO AddEnd
  222. AddChange:
  223. COLOR Blk,Cyn
  224. IF FldNum+1=<NumFlds-1 THEN
  225.   LOCATE 1+(FldNum+1)*2,1:PRINT SPACE$(20)
  226.   FOR n=FldNum+1 TO NumFlds-1
  227.     LOCATE 2+n*2,20-LEN(FldTxt$(n,0))+1:PRINT FldTxt$(n,0)
  228.     x%=x%+1:DrawGadgets x%,x%,bx(),bxtxt$()
  229.   NEXT
  230. END IF
  231. MOUSE OFF:GOSUB DoAChange:COLOR Blk,Blu:MOUSE ON
  232. LINE(85,147)-(260,170),Cyn,bf
  233. LOCATE 18,4:COLOR Cyn,Blu:PRINT SPACE$(12)+"Select Option"+SPACE$(13)
  234. DrawGadgets AddA%,AddC%,bx(),bxtxt$()
  235. type=0:WHILE type=0:SLEEP:WEND:MOUSE OFF
  236. ON type GOTO AddCancel,AddOK,AddChange
  237. AddOK:
  238. LSET FFlg$="0"
  239. FOR n=0 TO NumFlds-1
  240.   IF n<3 OR n>5 THEN
  241.     LSET RFld$(n)=FldVal$(n)
  242.   ELSE
  243.     RSET RFld$(n)=FldVal$(n)
  244.   END IF
  245. NEXT    
  246. LSET RAdd$=Today$:LSET RChg$=" "
  247. RecCnt=RecCnt+1
  248. PUT #1,RecCnt
  249. AddEnd:
  250. LOCATE 18,4:COLOR Cyn,Blu:PRINT" Your Request has been Complied With. "
  251. LINE(85,147)-(260,170),Cyn,bf
  252. DrawGadgets AddD%,AddE%,bx(),bxtxt$()
  253. A%=AddD%:B%=AddE%:MOUSE ON
  254. type=0:WHILE type=0:SLEEP:WEND:MOUSE OFF
  255. ON type GOTO AddClear,AddExit
  256. AddExit:
  257. IF RecCnt<>OldCnt THEN GOSUB PutRecCnt
  258. WINDOW CLOSE 3:GOTO Main2
  259.  
  260. ' Routine to REVIEW All Current Records
  261. ' -------------------------------------  
  262. ReviewRtn:
  263. MENU 3,0,0
  264. IF RecCnt=0 THEN RRNoRecs
  265. n=Sldlgth%
  266. BarLgth%=CINT((n/100)*((maxdisp/RecCnt)*100))
  267. IF BarLgth%>Sldlgth% THEN BarLgth%=Sldlgth%
  268. IF BarLgth%<5 THEN BarLgth%=5
  269. Spare%=Sldlgth%-BarLgth%
  270. COLOR Mag,Blk:CLS
  271. LOCATE 1,26:PRINT"REVIEW OF HOUSEHOLD INVENTORY"
  272. COLOR Yel,Blk:LOCATE 2,26:PRINT"Click on record to select it."
  273. LOCATE 3,25:PRINT USING "Number  of items on file: #####";RecCnt
  274. DrawGadgets RevC%,RevC%,bx(),bxtxt$()
  275. Hi1st%=1:IF RecCnt>maxdisp THEN Hi1st%=RecCnt-maxdisp
  276. COLOR Blu,Blk
  277. LOCATE 5,2:PRINT"Room------ Item----------- Pur-Date"
  278. LOCATE 5,38:PRINT"O-Cost CWorth R-Cost Serial-Number--"
  279. LINE(0,40)-(592,184),Cyn,bf
  280. DrawGadgets RevD%,RevF%,bx(),bxtxt$()
  281. COLOR Wht
  282. AREA(612,40):AREA STEP(-12,12):AREA STEP(24,0):AREAFILL
  283. AREA(612,184):AREA STEP(-12,-12):AREA STEP(24,0):AREAFILL
  284. DIM DispFile$(RecCnt-1)
  285. COLOR Red,Cyn:LOCATE 7,31:PRINT"Loading File"
  286. FOR n=0 TO RecCnt-1
  287.   GET #1,n+1
  288.   IF FFlg$="0" THEN Sep$=" " ELSE Sep$="*"
  289.   DispFile$(n)=Sep$
  290.   FOR m=0 TO NumFlds-2
  291.     DispFile$(n)=DispFile$(n)+RFld$(m)+Sep$
  292.   NEXT
  293. NEXT
  294. LOCATE 7,31:PRINT SPACE$(12)
  295. first=0
  296. IF RecCnt<maxdisp+1 THEN
  297.   last=RecCnt-1
  298.   COLOR Yel,Blk:LOCATE 4,31:PRINT"All Items Displayed"
  299. ELSE
  300.   last=maxdisp-1
  301. END IF
  302. DispScreen:
  303. GOSUB DispRecNo
  304. COLOR Blk,Cyn:row%=6-1
  305. LINE(0,40)-(592,184),Cyn,bf
  306. FOR n=first TO last
  307.   row%=row%+1:LOCATE row%,1:PRINT DispFile$(n)
  308. NEXT
  309. GOSUB DrawBar
  310. RevGdgt:
  311. A%=RevA%:B%=RevF%:MOUSE ON
  312. type=0:WHILE type=0:SLEEP:WEND:MOUSE OFF
  313. IF type<maxdisp+1 THEN GetRecord
  314. type=type-maxdisp
  315. ON type GOTO RevExit,ScrollUp,ChgDisp,ScrollDwn
  316. ScrollUp:
  317. IF first+1>1 THEN
  318.   first=first-1:last=last-1
  319.   GOTO DispScreen
  320. ELSE
  321.   GOTO RevGdgt
  322. END IF
  323. ScrollDwn:
  324. IF RecCnt>last+1 THEN
  325.   first=first+1:last=last+1
  326.   GOTO DispScreen
  327. ELSE
  328.   GOTO RevGdgt
  329. END IF
  330. ChgDisp:
  331. IF maxdisp=>RecCnt THEN RevGdgt
  332. offset%=MouseY%-(SldStrt%-1)
  333. offsetp%=CINT(offset%/Sldlgth%)*100
  334. first=((RecCnt/100)*offsetp%)
  335. last=first+(maxdisp-1)
  336. IF last>RecCnt THEN last=RecCnt-1
  337. first=(last-maxdisp)+1
  338. GOTO DispScreen
  339. GetRecord:
  340. IF type>(last-first)+1 THEN RevGdgt
  341. RecNum=first+type
  342. WINDOW 8,"Household Inventory: Update Item",(40,0)-(400,184),0,1
  343. COLOR Blk,Cyn:CLS
  344. GET #1,RecNum
  345. IF FFlg$="1" THEN
  346.   LOCATE 6,5:PRINT"The selected record has been deleted."
  347.   LOCATE 8,10:PRINT"Do you wish to restore it?"
  348.   DrawGadgets DQA%,DQB%,bx(),bxtxt$()
  349.   A%=DQA%:B%=DQB%:MOUSE ON
  350.   type=0:WHILE type=0:SLEEP:WEND:MOUSE OFF
  351.   IF type=1 THEN
  352.     LSET FFlg$="0":LSET RChg$=Today$
  353.     PUT #1,RecNum
  354.     COLOR Blk,Cyn:CLS
  355.     GOTO ShoRec
  356.   ELSE
  357.     GOTO GRExit
  358.   END IF
  359. END IF
  360. ShoRec:
  361. x%=ChgA%-1
  362. FOR n=0 TO NumFlds-1
  363.   FldVal$(n)=RFld$(n)
  364.   COLOR Blk,Cyn
  365.   LOCATE 2+n*2,20-LEN(FldTxt$(n,0))+1:PRINT FldTxt$(n,0)
  366.   x%=x%+1:DrawGadgets x%,x%,bx(),bxtxt$()
  367.   IF n>2 AND n<6 THEN
  368.     offset=0
  369.     FOR m=1 TO LEN(FldVal$(n))
  370.       IF MID$(FldVal$(n),m,1)<>" " THEN offset=m:m=LEN(FldVal$(n))
  371.     NEXT
  372.     IF offset=0 THEN FldVal$(n)="" ELSE FldVal$(n)=MID$(FldVal$(n),offset)
  373.   ELSE
  374.     siz=0
  375.     FOR m=LEN(FldVal$(n)) TO 1 STEP -1
  376.       IF MID$(FldVal$(n),m,1)<>" " THEN siz=m:m=1
  377.     NEXT
  378.     IF siz=0 THEN FldVal$(n)="" ELSE FldVal$(n)=MID$(FldVal$(n),1,siz)
  379.   END IF
  380.   COLOR Blk,Blu:LOCATE 2+n*2,22:PRINT FldVal$(n)
  381. NEXT
  382. LOCATE 18,4:COLOR Cyn,Blu:PRINT"   Please select desired function.    "
  383. DrawGadgets UpdA%,UpdB%,bx(),bxtxt$()
  384. A%=UpdA%:B%=UpdB%:MOUSE ON:type=0:WHILE type=0:SLEEP:WEND
  385. ON type GOTO GRMod,GRExit,GRDel
  386. GRMod:
  387. MOUSE OFF:GOSUB DoAChange:MOUSE ON
  388. IF RC<>0 THEN GRExit
  389. LSET FFlg$="0"
  390. FOR n=0 TO NumFlds-1
  391.   IF n<3 OR n>5 THEN
  392.     LSET RFld$(n)=FldVal$(n)
  393.   ELSE
  394.     RSET RFld$(n)=FldVal$(n)
  395.   END IF
  396. NEXT    
  397. LSET RChg$=Today$ 
  398. PUT #1,RecNum
  399. GOTO GRExit
  400. GRDel:
  401. LINE(85,148)-(300,172),Cyn,bf
  402. WINDOW 9,,(440,40)-(608,98),0,1
  403. COLOR Blu,Yel:CLS
  404. LOCATE 2,2:PRINT"OK to delete record"
  405. LOCATE 3,2:PRINT"shown at left?"
  406. DrawGadgets DelA%,DelB%,bx(),bxtxt$()
  407. A%=DelA%:B%=DelB%:type=0:WHILE type=0:SLEEP:WEND
  408. ON type GOTO GRDelEnd,GRDelYes
  409. GRDelYes:
  410. LSET FFlg$="1"
  411. PUT #1,RecNum
  412. GRDelEnd:
  413. WINDOW CLOSE 9
  414. GOTO GRExit
  415. GRExit:
  416. MOUSE OFF:WINDOW CLOSE 8
  417. GOTO RevGdgt
  418.  
  419. ' No Records to Review
  420. RRNoRecs:
  421. MENU OFF
  422. WINDOW 4,,(440,40)-(608,80),0,1
  423. COLOR Blu,Yel:CLS
  424. LOCATE 2,3:PRINT"No Data to Review"
  425. LOCATE 4,3:PRINT"Press left Button"
  426. LOCATE 5,3:PRINT"to Continue."
  427. WHILE MOUSE(0)=0:WEND
  428. WINDOW CLOSE 4
  429. MENU ON
  430. GOTO Main2
  431.  
  432. DispRecNo:
  433. IF RecCnt>maxdisp THEN
  434.   COLOR Yel,Blk:LOCATE 4,22
  435.   PRINT USING "Record number at top of display: #####";first+1
  436. END IF
  437. RETURN
  438.  
  439. DrawBar:
  440. BarStrt%=SldStrt%+(Spare%-((RecCnt-(last+1))*(Spare%/Hi1st%)))
  441. DrawGadgets RevE%,RevE%,bx(),bxtxt$()
  442. LINE(SldLft%,BarStrt%)-STEP(17,BarLgth%),Wht,bf
  443. RETURN
  444.  
  445. ' Leave Review Routine
  446. RevExit:                 
  447. ERASE DispFile$
  448. MENU 3,0,1
  449. GOTO Main
  450.  
  451. ' Change an Existing Record (During Either ADD or REVIEW)
  452. ' -------------------------------------------------------
  453. DoAChange:
  454. SvA%=A%:SvB%=B%
  455. FOR n=0 TO NumFlds-1:HldVal$(n)=FldVal$(n):NEXT
  456. LINE(85,147)-(260,170),Cyn,bf
  457. DrawGadgets ChgC%,ChgD%,bx(),bxtxt$()
  458. DACGdgt:
  459. COLOR Cyn,Blu:LOCATE 18,4:PRINT" Click in box it is desired to change "
  460. A%=ChgA%:B%=ChgD%:MOUSE ON
  461. type=0:WHILE type=0:SLEEP:WEND:MOUSE OFF
  462. IF type>8 THEN
  463.   type=type-8
  464.   ON type GOTO ChngCancel,ChngOK
  465. END IF
  466. COLOR Cyn,Blu:LOCATE 18,4:PRINT"   Press RETURN after making change   "
  467. n=type-1:Lgth%=Fldlen%(n):strg$=FldVal$(n):COLOR Blk,Wht
  468. IF n>2 AND n<6 THEN type$="REAL" ELSE type$="CHAR"
  469. LOCATE 2+n*2,22:GetIp strg$,type$,Lgth%
  470. IF n<2 THEN
  471.   WHILE strg$="":LOCATE 2+n*2,22:GetIp strg$,type$,Lgth%:WEND
  472. END IF
  473. FldVal$(n)=strg$
  474. GOTO DACGdgt
  475. ChngCancel:
  476. COLOR ,Cyn:LOCATE 18,4:PRINT SPACE$(38)
  477. COLOR Blk,Blu:x%=ChgA%-1
  478. FOR n=0 TO NumFlds-1
  479.   FldVal$(n)=HldVal$(n)
  480.   x%=x%+1:DrawGadgets x%,x%,bx(),bxtxt$()
  481.   LOCATE 2+n*2,22:PRINT FldVal$(n)
  482. NEXT
  483. FldNum=n:RC=4
  484. GOTO DACExit
  485. ChngOK:
  486. RC=0
  487. DACExit:
  488. A%=SvA%:B%=SvB%:COLOR Blu,Cyn
  489. RETURN
  490.  
  491. ' INPUT and WRITE Record Count
  492. ' ----------------------------
  493. GetRecCnt:
  494. OPEN "HouseInv.Count" FOR INPUT AS #2
  495. INPUT #2,RecCnt
  496. CLOSE #2
  497. RETURN
  498. PutRecCnt:
  499. WINDOW 5,,(440,40)-(608,80),0,1
  500. COLOR Blu,Yel:CLS
  501. LOCATE 2,4:PRINT"Updating Count"
  502. LOCATE 3,9:PRINT"File"
  503. OldCnt=RecCnt
  504. OPEN "HouseInv.Count" FOR OUTPUT AS #2
  505. WRITE #2,RecCnt
  506. CLOSE #2
  507. WINDOW CLOSE 5
  508. RETURN
  509.  
  510. ' Time to QUIT and Return to Basic
  511. ' --------------------------------
  512. Quit:
  513. IF RecCnt<>OldCnt THEN GOSUB PutRecCnt
  514. CLOSE #1:CLOSE #2
  515. MENU OFF:MENU RESET
  516. CLS:WINDOW CLOSE 2:SCREEN CLOSE 1:END
  517.  
  518. ' Mouse Interrupt Routine
  519. ' -----------------------
  520. GetMouse:
  521. GetGadget A%,B%,bx(),bxtxt$(),type
  522. RETURN
  523.  
  524. ' Menu Request Handling Routines
  525. ' ------------------------------
  526. MenuRtns:
  527. MOUSE OFF:SvA%=A%:SvB%=B%
  528. m=MENU(0):i=MENU(1)
  529. MENU OFF
  530. ON m GOTO ProjRtn,HelpRtn,DataRtn
  531. ProjRtn:
  532. ON i GOTO Mquit
  533. Mquit:
  534. GOTO Quit
  535. HelpRtn:
  536. GOSUB DoHelp:GOTO MRExit
  537. DataRtn:
  538. ON i GOTO MInit,MUpdtCnt,MNum
  539. MInit:
  540. WINDOW 6,,(440,40)-(608,96),0,1
  541. COLOR Blu,Yel:CLS
  542. LOCATE 2,2:PRINT"This  option   will"
  543. LOCATE 3,2:PRINT"delete all  records"
  544. LOCATE 4,2:PRINT"on file."
  545. DrawGadgets InA%,InB%,bx(),bxtxt$()
  546. A%=InA%:B%=InB%:GOSUB MenuMouse
  547. IF RecCnt>0 AND type=2 THEN
  548.   CLOSE #1
  549.   KILL"HouseInv.Data.info"
  550.   KILL"HouseInv.Data"
  551.   GOSUB OpenData
  552. END IF
  553. WINDOW CLOSE 6
  554. ON type GOTO MInExit,MInOK
  555. MInOK:
  556. RecCnt=0:GOSUB PutRecCnt
  557. MInExit:
  558. GOTO MRExit
  559. MUpdtCnt:
  560. GOSUB PutRecCnt
  561. GOTO MRExit
  562. MNum:
  563. WINDOW 6,,(440,40)-(608,136),0,1
  564. COLOR Blu,Yel:CLS
  565. LOCATE 2,4:PRINT"Record  Counts"
  566. LOCATE 4,2:PRINT USING"Commited:  #####";OldCnt
  567. LOCATE 5,2:PRINT USING"In system: #####";RecCnt
  568. IF OldCnt<>RecCnt THEN
  569.   LOCATE 7,2:PRINT"Use  'Update Count'"
  570.   LOCATE 8,2:PRINT"menu to commit  all"
  571.   LOCATE 9,2:PRINT"all records."
  572. END IF
  573. DrawGadgets CnA%,CnA%,bx(),bxtxt$()
  574. A%=CnA%:B%=CnA%:GOSUB MenuMouse
  575. WINDOW CLOSE 6
  576. GOTO MRExit
  577. MRExit:
  578. A%=SvA%:B%=SvB%:type=0:MOUSE ON:MENU ON
  579. RETURN
  580.  
  581. ' Help Routines (requested via Menu Routines)
  582. DoHelp:
  583. WINDOW 9,,(408,0)-(631,186),0,1
  584. COLOR Blu,Yel:CLS:LOCATE 2,1
  585. ON i GOTO HlpGen,HlpAdd,HlpRev,HlpData,HlpIPrt,HlpIMaint
  586. HlpGen:
  587. PRINT" 'The  Household  Inventory"
  588. PRINT" System'  is  made  up   of"
  589. PRINT" three programs:  HouseInv,"
  590. PRINT" HouseInvPrint,         and"
  591. PRINT" HouseInvMaint.":PRINT" "
  592. PRINT" These programs allow users"
  593. PRINT" to  create, maintain,  and"
  594. PRINT" report on a file of  their"
  595. PRINT" Household Inventory.   The"
  596. PRINT" data   are  stored  in   a"
  597. PRINT" direct access file on  the"
  598. PRINT" same disk as that used  by"
  599. PRINT" the program.":PRINT" "
  600. PRINT" Other Help menu items pro-"
  601. PRINT" vide further  information."
  602. DrawGadgets HlpA%,HlpB%,bx(),bxtxt$()
  603. A%=HlpA%:B%=HlpB%:GOSUB MenuMouse
  604. ON type GOTO HlpGen1,HlpExit
  605. HlpGen1:
  606. COLOR Blu,Yel:CLS:LOCATE 2,1
  607. PRINT" "
  608. PRINT" These  programs, the  data"
  609. PRINT" files, and a copy of Basic"
  610. PRINT" should  be kept on a  sep-"
  611. PRINT" arate  disk,  a  copy   of"
  612. PRINT" which   is  stored  in   a"
  613. PRINT" Safety Deposit Box."
  614. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  615. A%=HlpB%:B%=HlpB%:GOSUB MenuMouse
  616. GOTO HlpExit
  617. HlpAdd:
  618. PRINT" Only Room & Item are  Man-"
  619. PRINT" datory.  Either enter  the"
  620. PRINT" requested  data,   (RETURN"
  621. PRINT" must be pressed for it  to"
  622. PRINT" register),  or  click   in"
  623. PRINT" the desired gadget:":PRINT" "
  624. PRINT" Cancel   -clear the item"
  625. PRINT" OK       -add item to file"
  626. PRINT" Modify   -modify data just"
  627. PRINT"           entered":PRINT" "
  628. PRINT" If Cancel or OK selected:"
  629. PRINT" Add More -add another item"
  630. PRINT" Quit     -end add;  update"
  631. PRINT"           count file"
  632. DrawGadgets HlpA%,HlpB%,bx(),bxtxt$()
  633. A%=HlpA%:B%=HlpB%:GOSUB MenuMouse
  634. ON type GOTO HlpAdd1,HlpExit
  635. HlpAdd1:
  636. COLOR Blu,Yel:CLS:LOCATE 2,1
  637. PRINT" When 'Modify' is selected,"
  638. PRINT" click   on  item   it   is"
  639. PRINT" desired  to  change,   and"
  640. PRINT" enter or update the value."
  641. PRINT" When  updating,  ESC  will"
  642. PRINT" clear  the value to  null."
  643. PRINT" 'RETURN'  must be  pressed"
  644. PRINT" for  change  to  register."
  645. PRINT" Click  on  desired  gadget"
  646. PRINT" when appropriate:":PRINT" "
  647. PRINT" Cancel -Changes        are"
  648. PRINT"         removed"
  649. PRINT" Add    -Changes     remain":PRINT" "
  650. PRINT" In  both  cases  you   are"
  651. PRINT" returned  to the  original"
  652. PRINT" window."
  653. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  654. A%=HlpB%:B%=HlpB%:GOSUB MenuMouse
  655. GOTO HlpExit:
  656. HlpRev:
  657. PRINT" 'Review'  allows  you   to"
  658. PRINT" browse  through  the  data"
  659. PRINT" file.  Click in the slider"
  660. PRINT" to move several records at"
  661. PRINT" a time, or the arrow heads"
  662. PRINT" to   scroll  one   record."
  663. PRINT" Clicking on a record  will"
  664. PRINT" give you an Update  Window"
  665. PRINT" with gadgets:":PRINT" "
  666. PRINT" Modify -modify record"
  667. PRINT" OK     -accept changes and" 
  668. PRINT"         return to Review"
  669. PRINT" Delete -delete record":PRINT" "
  670. PRINT" See  Add  Help  for   more"
  671. PRINT" information on Modify."
  672. DrawGadgets HlpA%,HlpB%,bx(),bxtxt$()
  673. A%=HlpA%:B%=HlpB%:GOSUB MenuMouse
  674. ON type GOTO HlpRev1,HlpExit
  675. HlpRev1:                     
  676. COLOR Blu,Yel:CLS:LOCATE 2,1
  677. PRINT" Delete is a logical delete"
  678. PRINT" I.E.  it is  not  actually"
  679. PRINT" deleted   from  the   file"
  680. PRINT" until  the file is  reorg-"
  681. PRINT" anized,  when it  is  gone"
  682. PRINT" forever!  Instead, it will"
  683. PRINT" show  up with fields  sep-"
  684. PRINT" arated  by asterisks.   It"
  685. PRINT" may   be    restored    by" 
  686. PRINT" clicking  on it, AND  then"
  687. PRINT" the   subsequent     'Yes'"
  688. PRINT" gadget.":PRINT" "
  689. PRINT" 'Review' shows the file as"
  690. PRINT" it was at the time of  the"
  691. PRINT" request.    Changes    and"
  692. PRINT" deletes   will  not   show"
  693. PRINT" until the next 'Review'."
  694. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  695. A%=HlpB%:B%=HlpB%:GOSUB MenuMouse
  696. GOTO HlpExit
  697. HlpData:
  698. PRINT" The   'Data  File'   menu "
  699. PRINT" provides:":PRINT" "
  700. PRINT" Initialize -creates a zero"
  701. PRINT"    count file.   Use  very"
  702. PRINT"    first time or when  re-"
  703. PRINT"    starting from  scratch."
  704. PRINT" Update Count  -count  file"
  705. PRINT"    is  updated to  reflect"
  706. PRINT"    newly added records."
  707. PRINT" No. of Records      -lists"
  708. PRINT"    number  of  records  in"
  709. PRINT"    system  and  known   by"
  710. PRINT"    count file."
  711. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  712. A%=HlpB%:B%=HlpB%:GOSUB MenuMouse
  713. GOTO HlpExit
  714. HlpIPrt:
  715. HlpIMaint:
  716. PRINT" In the interests of memory"
  717. PRINT" conservation and increased"
  718. PRINT" flexibility, the   printer"
  719. PRINT" and    file    maintenance"
  720. PRINT" routines are contained  in"
  721. PRINT" separate  programs   named"
  722. PRINT" 'HouseInvPrint'        and"
  723. PRINT" 'HouseInvMaint'.":PRINT" "
  724. PRINT" Please  use the Help menus"
  725. PRINT" in   those  programs   for"
  726. PRINT" further information."
  727. DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
  728. A%=HlpB%:B%=HlpB%:GOSUB MenuMouse
  729. GOTO HlpExit
  730. HlpExit:
  731. WINDOW CLOSE 9:RETURN
  732.  
  733. ' Mouse Routine for Menu Routines
  734. MenuMouse:
  735. type=0
  736. WHILE type=0:GetGadget A%,B%,bx(),bxtxt$(),type:WEND
  737. RETURN
  738.  
  739. ' Various SUBPROGRAMS
  740. ' -------------------
  741. SUB Logo80 (Depth%) STATIC
  742. SHARED Blk,Blu,Grn,Cyn,Red,Mag,Yel,Wht
  743. IF first=0 THEN
  744.   first=1
  745.   SCREEN 1,640,200,Depth%,2
  746.   WINDOW 2,,,16,1
  747.   COLOR ,0:CLS
  748.   PALETTE 0,0,0,0  :Blk=0:'Black
  749.   PALETTE 1,0,0,1  :Blu=1:'Blue
  750.   PALETTE 2,0,.75,0:Grn=2:'Green
  751.   PALETTE 3,0,1,1  :Cyn=3:'Cyan
  752.   PALETTE 4,1,0,0  :Red=4:'Red
  753.   PALETTE 5,1,0,1  :Mag=5:'Magenta
  754.   PALETTE 6,1,.8,0 :Yel=6:'Yellow
  755.   PALETTE 7,1,1,1  :Wht=7:'White
  756. END IF
  757. COLOR ,Blk:CLS
  758. AREA(376,8):AREA STEP(64,0):AREA STEP(-20,16)
  759. AREA STEP(0,24):AREA STEP(-24,0):AREA STEP(0,-24)
  760. COLOR Blu:AREAFILL
  761. AREA(360,8):AREA STEP(32,0):AREA STEP(0,12)
  762. AREA STEP(-16,0):AREA STEP(0,4):AREA STEP(8,0):AREA STEP(0,8)
  763. AREA STEP(-8,0):AREA STEP(0,4):AREA STEP(24,0):AREA STEP(0,12)
  764. AREA STEP(-40,0):COLOR Grn:AREAFILL
  765. AREA(328,8):AREA STEP(24,0):AREA STEP(0,28)
  766. AREA STEP(24,0):AREA STEP(0,12):AREA STEP(-48,0)
  767. COLOR Red:AREAFILL
  768. AREA(272,8):AREA STEP(64,0):AREA STEP(0,12)
  769. AREA STEP(-20,0):AREA STEP(0,28):AREA STEP(-24,0):AREA STEP(0,-28)
  770. AREA STEP(-20,0):COLOR Cyn:AREAFILL
  771. AREA(264,8):AREA STEP(16,0):AREA STEP(24,40)
  772. AREA STEP(-16,0):AREA STEP(-8,-12):AREA STEP(-16,0):AREA STEP(-8,12)
  773. AREA STEP(-16,0):COLOR Mag:AREAFILL
  774. AREA(200,8):AREA STEP(56,0):AREA STEP(0,16)
  775. AREA STEP(-24,0):AREA STEP(0,-4):AREA STEP(-8,0):AREA STEP(0,16)
  776. AREA STEP(8,0):AREA STEP(0,-4):AREA STEP(24,0):AREA STEP(0,16)
  777. AREA STEP(-56,0):COLOR Yel:AREAFILL
  778. COLOR Blu,Blk:LOCATE 24,7
  779. PRINT"Bryan D. Catley  2221 Glasgow Road  Alexandria  Virginia  22307-1819";
  780. END SUB
  781.  
  782. SUB Bldgadgets (Num,T1(),T2$()) STATIC
  783. FOR n=0 TO Num-1
  784.   FOR m=0 TO 6
  785.     READ T1(n,m)
  786.   NEXT m
  787.   READ T2$(n)
  788. NEXT n
  789. END SUB
  790.  
  791. SUB DrawGadgets (Ga%,Gb%,T1(),T2$()) STATIC
  792. FOR n=Ga% TO Gb%
  793.   x1=T1(n,0):y1=T1(n,1):x2=x1+T1(n,2):y2=y1+T1(n,3)
  794.   bg=T1(n,4):fg=T1(n,5):bo=T1(n,6)
  795.   LINE(x1,y1)-(x2,y2),bg,bf:LINE(x1,y1)-(x2,y2),fg,B
  796.   IF bo>-1 THEN
  797.     LINE(x1+2,y1+2)-(x2-2,y2-2),fg,B
  798.     LINE(x2+1,y1+1)-(x2+1,y2+1),bo
  799.     LINE(x2+1,y2+1)-(x1+1,y2+1),bo
  800.     COLOR fg,bg:row%=INT(y1/8+2):col%=INT(x1/8+2)
  801.     LOCATE row%,col%:PRINT T2$(n);
  802.   END IF
  803. NEXT n
  804. END SUB
  805.  
  806. SUB GetGadget (Ga%,Gb%,T1(),T2$(),type) STATIC
  807. SHARED MouseX%,MouseY%,MouseInd
  808. WHILE MOUSE(0)=0:WEND
  809. r%=CSRLIN:c%=POS(0)
  810. mx=MOUSE(1):my=MOUSE(2)
  811. MouseX%=mx:MouseY%=my:MouseInd=0
  812. FOR n=Ga% TO Gb%
  813.   IF mx>T1(n,0) AND mx<T1(n,0)+T1(n,2) THEN
  814.     IF my>T1(n,1) AND my<T1(n,1)+T1(n,3) THEN
  815.       bg=T1(n,4):fg=T1(n,5):bo=T1(n,6)
  816.       IF bo>-1 THEN
  817.         x1=T1(n,0)+2:y1=T1(n,1)+2
  818.         x2=x1+T1(n,2)-4:y2=y1+T1(n,3)-4
  819.         LINE(x1,y1)-(x2,y2),fg,bf
  820.         COLOR bg,fg:row%=INT(y1/8+2):col%=INT(x1/8+2)
  821.         LOCATE row%,col%:PRINT T2$(n);
  822.       ELSE
  823.         IF bo=-1 THEN
  824.           x1=T1(n,0):y1=T1(n,1):x2=x1+T1(n,2):y2=y1+T1(n,3)
  825.           LINE(x1,y1)-(x2,y2),fg,bf:LINE(x1,y1)-(x2,y2),bg,B
  826.         END IF
  827.       END IF
  828.       type=n-Ga%+1:n=Gb%:MouseInd=1
  829.       IF bo>-1 THEN n%=type+Ga%-1
  830.     END IF
  831.   END IF
  832. NEXT n
  833. WHILE MOUSE(0)<>0:WEND
  834. IF type<>0 AND bo>-1 THEN DrawGadgets n%,n%,T1(),T2$()
  835. LOCATE r%,c%
  836. END SUB
  837.  
  838. SUB GetIp (Text$,DataType$,MaxLen%) STATIC
  839. SHARED TxtCol,NewCur,MouseInd
  840. start=POS(0):cur=0:COLOR TxtCol
  841. xpix=(start-1)*8:ypix=(CSRLIN-1)*8
  842. IF FirstTime=0 THEN FirstTime=1:NewCur=1:DIM IPcursor%(46)
  843. IF NewCur=1 THEN
  844.   NewCur=0
  845.   CurCol=TxtCol-1:IF CurCol<0 THEN CurCol=TxtCol+1
  846.   LINE(xpix,ypix)-STEP(7,7),CurCol,bf
  847.   GET(xpix,ypix)-STEP(7,7),IPcursor%
  848. END IF
  849. ShoText:
  850. GOSUB DisplayText
  851. NxtChar:
  852. x$="":MouseInd=0:LeftPart$="":RightPart$=""
  853. WHILE x$="" AND MouseInd=0:x$=INKEY$:WEND
  854. IF MouseInd<>0  THEN GetDone  ' Mouse was clicked
  855. IF x$=CHR$(30)  THEN CurRight ' Right-cursor
  856. IF x$=CHR$(31)  THEN CurLeft  ' Left-cursor
  857. IF x$=CHR$(8)   THEN DelLeft  ' Back-space key
  858. IF x$=CHR$(127) THEN DelRight ' Delete key
  859. IF x$=CHR$(27)  THEN ClrText  ' Escape key
  860. IF x$=CHR$(13)  THEN GetDone  ' Return key
  861. IF DataType$="CHAR" THEN
  862.   IF x$<CHR$(32) OR x$>CHR$(127) THEN 
  863.     BEEP:GOTO NxtChar
  864.   END IF
  865. ELSEIF DataType$="REAL" THEN
  866.   IF (x$<CHR$(48) OR x$>CHR$(57)) AND (x$<>".") THEN
  867.     BEEP:GOTO NxtChar
  868.   END IF
  869. ELSEIF DataType$="INT" THEN
  870.   IF x$<CHR$(48) OR x$>CHR$(57) THEN
  871.     BEEP:GOTO NxtChar
  872.   END IF
  873. END IF
  874. InsertChar:
  875. IF LEN(Text$)=MaxLen% THEN BEEP:GOTO NxtChar
  876. IF cur>0 THEN LeftPart$=MID$(Text$,1,cur)
  877. IF LEN(Text$)>0 THEN RightPart$=MID$(Text$,cur+1,LEN(Text$)-LEN(LeftPart$))
  878. Text$=LeftPart$+x$+RightPart$:cur=cur+1
  879. GOTO ShoText
  880. CurRight:
  881. IF cur=LEN(Text$) THEN NxtChar
  882. cur=cur+1:GOTO ShoText
  883. CurLeft:
  884. IF cur=0 THEN NxtChar
  885. cur=cur-1:GOTO ShoText
  886. DelLeft:
  887. IF LEN(Text$)=0 OR cur=0 THEN BEEP:GOTO NxtChar
  888. IF cur>1 THEN LeftPart$=MID$(Text$,1,cur-1)
  889. IF LEN(Text$)>cur THEN RightPart$=MID$(Text$,cur+1,LEN(Text$)-cur)
  890. Text$=LeftPart$+RightPart$
  891. cur=cur-1:GOTO ShoText
  892. DelRight:
  893. IF LEN(Text$)=0 OR cur=LEN(Text$) THEN BEEP:GOTO NxtChar
  894. IF cur>0 THEN LeftPart$=MID$(Text$,1,cur)
  895. IF cur+1<LEN(Text$) THEN RightPart$=MID$(Text$,cur+2,LEN(Text$)-cur+1)
  896. Text$=LeftPart$+RightPart$
  897. GOTO ShoText
  898. ClrText:
  899. PRINT SPACE$(MaxLen%+1);:LOCATE ,start
  900. cur=0:Text$="":GOTO ShoText
  901. DisplayText:
  902. PRINT Text$+SPACE$(MaxLen%+1-LEN(Text$));:LOCATE ,start
  903. xpix=(start+cur-1)*8:PUT(xpix,ypix),IPcursor%
  904. RETURN
  905. GetDone:
  906. PUT(xpix,ypix),IPcursor%
  907. END SUB
  908.  
  909.   
  910.